home *** CD-ROM | disk | FTP | other *** search
/ Leisure Game Pak / Leisure Game Pak.iso / lpgame1 / 04 / source / mouse.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-17  |  7.1 KB  |  281 lines
  1. UNIT     MOUSE;
  2. {$F+}
  3. INTERFACE
  4.  
  5. CONST   NO_MOUSEBUTTON       = 0;
  6.     LEFTMOUSEBUTTON    = 1;
  7.     RIGHTMOUSEBUTTON   = 2;
  8.         MIDDLEMOUSEBUTTON  = 4;
  9.  
  10.         HARD_DRAG  = TRUE;        (*  not interruptable  *)
  11.         SOFT_DRAG  = FALSE;        (*  interruptable  *)
  12.  
  13.  
  14. FUNCTION     HasMouse : BOOLEAN;
  15. PROCEDURE     ShowMouse;
  16. PROCEDURE    ShowMouseReally;
  17. PROCEDURE     HideMouse;
  18. FUNCTION      GetMousePos(VAR x, y : WORD) : BYTE;
  19.         { GetMousePos returns the button pressed }
  20. PROCEDURE     SetMousePos(x, y : WORD);
  21. FUNCTION    WaitMouseButtons(none_ok, left_ok,
  22.                  right_ok, both_ok : BOOLEAN) : BYTE;
  23.         { waits until a valid set of mouse buttons is pressed }
  24. PROCEDURE     ButtonPressed(Button : WORD;  VAR x, y, but, count : WORD);
  25. PROCEDURE     ButtonReleased(Button : WORD;  VAR x, y, but, count : WORD);
  26. PROCEDURE     MouseXRange (min, max : WORD);
  27. PROCEDURE     MouseYRange (min, max : WORD);
  28. PROCEDURE     MouseMove(VAR  dx, dy : INTEGER);
  29. PROCEDURE     SetMouseSpeed(sx, sy : WORD);
  30. PROCEDURE     SetMouseButtonProc(Buttons : WORD;  ProcPtr : POINTER);
  31. PROCEDURE     HideMouseIn(x1, y1, dx, dy : WORD);
  32. FUNCTION    DragMouse(x2, y2    : INTEGER;
  33.               hard_drag : BOOLEAN) : BOOLEAN;
  34. FUNCTION      GetMouseButton : BYTE;
  35.         {GetMouseButton returns the button pressed }
  36. FUNCTION    MouseTouched : BOOLEAN;
  37.         { TRUE, if Button is pressed or mouse was moved }
  38.  
  39. IMPLEMENTATION
  40.  
  41. USES DOS, Timing;
  42.  
  43. { to show mouse REALLY, count in TimesHidden how often you hid the mouse }
  44. CONST   TimesHidden : WORD = 1;
  45.  
  46.     mouse_step  : WORD = 1;     (* to adjust mouse-drag-speed *)
  47.     mouse_delay : WORD = 0;
  48.  
  49. VAR       R : Registers;
  50.  
  51. FUNCTION     HasMouse : boolean;
  52. VAR    MouseInt: POINTER;
  53. BEGIN
  54.       R.AX := 0;  R.BX := 0;
  55.     GetIntVec($33, MouseInt);
  56.       IF (MouseInt <> NIL)  THEN  Intr($33,R);
  57.       HasMouse := (R.BX > 0);
  58. END;      { HasMouse }
  59.  
  60.  
  61. PROCEDURE     ShowMouse;
  62. BEGIN    R.AX := 1;  Intr($33,R);
  63.     IF  (TimesHidden > 0)  THEN  DEC(TimesHidden);
  64. END;    { ShowMouse }
  65.  
  66. { to show mouse REALLY, you have to show it as often as you hid it earlier }
  67. PROCEDURE    ShowMouseReally;
  68. BEGIN
  69.     REPEAT
  70.         ShowMouse;
  71.         UNTIL  (TimesHidden = 0);
  72. END;    { ShowMouseReally }
  73.  
  74. PROCEDURE     HideMouse;
  75. BEGIN    R.AX := 2;  Intr($33,R);
  76.     IF  (TimesHidden < 65535)  THEN  INC(TimesHidden);
  77. END;    { HideMouse }
  78.  
  79.  
  80. {GetMousePos returns the button pressed }
  81. FUNCTION      GetMousePos(VAR x, y : WORD) : BYTE;
  82. BEGIN
  83.       R.AX := 3;  Intr($33,R);
  84.     x := R.CX;  y:=R.DX;
  85.     GetMousePos := R.BX;
  86. END;     { GetMousePos }
  87.  
  88. PROCEDURE     SetMousePos(x,y : WORD);
  89. BEGIN
  90.       R.AX := 4;  R.CX := x;  R.DX := y;
  91.       Intr($33,R);
  92. END;     { SetMousePos }
  93.  
  94.  
  95. FUNCTION    WaitMouseButtons(none_ok, left_ok,
  96.                  right_ok, both_ok : BOOLEAN) : BYTE;
  97. VAR    x, y : WORD;
  98.     b    : BYTE;
  99.         ok   : BOOLEAN;
  100. BEGIN
  101.         ok := FALSE;
  102.     REPEAT
  103.         b := GetMousePos(x,y);
  104.                 CASE  b  OF
  105.                    NO_MOUSEBUTTON     :     ok := none_ok;
  106.                    LEFTMOUSEBUTTON    :  ok := left_ok;
  107.                    RIGHTMOUSEBUTTON   :  ok := right_ok;
  108.                    LEFTMOUSEBUTTON +
  109.                    RIGHTMOUSEBUTTON   :  ok := both_ok;
  110.                 END; { CASE }
  111.     UNTIL  (ok);
  112.         WaitMouseButtons := b;
  113. END;    {WaitMouseButtons }
  114.  
  115.  
  116. PROCEDURE     ButtonPressed(Button : WORD;
  117.             VAR x, y, but, count : WORD);
  118. BEGIN
  119.     R.AX := 5;  R.BX := Button;
  120.     Intr($33,R);
  121.         x := R.CX;  y := R.DX;  but := R.AX;  count := R.BX;
  122. END;    { ButtonPressed }
  123.  
  124.  
  125. PROCEDURE     ButtonReleased(Button : WORD;
  126.              VAR x, y, but, count : WORD);
  127. BEGIN
  128.     R.AX := 6;  R.BX := Button;
  129.     Intr($33,R);
  130.         x := R.CX;  y := R.DX;  but := R.AX;  count := R.BX;
  131. END;    { ButtonReleased }
  132.  
  133.  
  134. PROCEDURE     MouseXRange (min, max : WORD);
  135. BEGIN
  136.     R.AX := 7;  R.CX := min;  R.DX := max;
  137.     Intr($33,R);
  138. END;    { MouseXRange }
  139.  
  140. PROCEDURE     MouseYRange (min, max : WORD);
  141. BEGIN
  142.     R.AX := 8;  R.CX := min;  R.DX := max;
  143.     Intr($33,R);
  144. END;    { MouseYRange }
  145.  
  146.  
  147. PROCEDURE     SetMousePointer(width, height : WORD;  data : POINTER);
  148. BEGIN
  149.     R.AX := 9;  R.BX := width;  R.CX := height;
  150.           R.ES := Seg(data^);  R.DX := Ofs(data^);
  151.         Intr($33,R);
  152. END;    { SetMousePointer }
  153.  
  154.  
  155. PROCEDURE     MouseMove(VAR  dx, dy : INTEGER);
  156. BEGIN
  157.     R.AX := 11;  Intr($33,R);
  158.     dx := INTEGER(R.CX);  dy := INTEGER(R.DX)
  159. END;    { MouseMove }
  160.  
  161.  
  162. PROCEDURE     SetMouseButtonProc(Buttons : WORD;  ProcPtr : POINTER);
  163. BEGIN
  164.     R.AX := 12;  R.CX := Buttons;
  165.     R.DX := Seg(ProcPtr^);  R.ES := Ofs(ProcPtr^);
  166.     Intr($33,R);
  167. END;    { SetMouseButtonProc }
  168.  
  169.  
  170. PROCEDURE     SetMouseSpeed(sx, sy : WORD);
  171. BEGIN
  172.       R.AX := 15;  R.CX := sx;  R.DX := sy;
  173.     Intr($33,R)
  174. END;    { SetMouseSpeed }
  175.  
  176.  
  177. PROCEDURE     HideMouseIn(x1, y1, dx, dy : WORD);
  178. BEGIN
  179.     R.AX := 16;
  180.     R.CX := x1;  R.DX := y1;
  181.     R.SI := x1 + PRED(dx);  R.DI := y1 + PRED(dy);
  182.     Intr($33,R);
  183. END;    { HideMouseIn }
  184.  
  185.  
  186.  
  187. {  ..............................  special routines  }
  188.  
  189.  
  190. {  drag mousepointer to the position (x2,y2)  }
  191. FUNCTION    DragMouse(x2, y2    : INTEGER;
  192.               hard_drag : BOOLEAN) : BOOLEAN;
  193. CONST    MAXMOVE = 120;
  194.     MINMEASURE = 200;
  195.  
  196.  
  197.  
  198. VAR    dx, dy,
  199.     dmx, dmy: INTEGER;
  200.         b,
  201.     x, y,
  202.     x1, y1    : WORD;
  203.     mmove,
  204.     t, tmax    : LONGINT;
  205.         drag_ok,
  206.         y_bow   : BOOLEAN;
  207. BEGIN
  208.     MouseMove(dmx, dmy);        { reset mousemoves }
  209.     b := GetMousePos(x1, y1);
  210.     dx := x2 - x1;
  211.         dy := y2 - y1;
  212.  
  213.         y_bow := abs(dx) > abs(dy);
  214.         if y_bow then
  215.             tmax := abs(dx)
  216.         else
  217.             tmax := abs(dy);
  218.  
  219.  
  220.         IF  (tmax > MINMEASURE)  THEN  (* adjust drag time *)
  221.            StartMeasure;
  222.  
  223.         mmove := 0;
  224.         t := 1;        {  stop immediately if tmax = 0  }
  225.         drag_ok := TRUE;
  226.  
  227.         WHILE  (drag_ok) AND (t < tmax)  DO
  228.         BEGIN
  229.         MouseMove(dmx, dmy);        { get mousemoves }
  230.                 INC(mmove, ABS(dmx) + ABS(dmy));
  231.                 {  see whether soft_drag is still ok  ... x,y are just dummies  }
  232.         drag_ok := (hard_drag)  OR
  233.                    ((GetMousePos(x,y) = NO_MOUSEBUTTON) AND
  234.                 (mmove <= MAXMOVE));
  235.  
  236.                 { the linear part of the drag ... }
  237.             x := x1 + (t * dx) DIV tmax;
  238.             y := y1 + (t * dy) DIV tmax;
  239.  
  240.                 { ... plus the bow,
  241.           note: the bow part has to be 0 for t=0 and t=tmax }
  242.                 IF  (y_bow)  THEN    (*  bow y coord  *)
  243.                     INC(y,t - (t*t) DIV tmax)
  244.         else
  245.                     INC(x,t - (t*t) DIV tmax);
  246.  
  247.                 SetMousePos(x,y);
  248.                 INC(t, mouse_step);
  249.                 MyDelay(mouse_delay);
  250.         END;  (* WHILE *)
  251.  
  252.         IF  drag_ok  THEN BEGIN
  253.        SetMousePos(x2, y2);
  254.        IF (tmax > MINMEASURE)  THEN  (* adjust drag time *)
  255.               GetStepDelay(tmax, tmax, mouse_step, mouse_delay);
  256.         END; (* if *)
  257.  
  258.         DragMouse := drag_ok;
  259.  
  260. END;    { DragMouse }
  261.  
  262. {GetMouseButton returns the button pressed }
  263. FUNCTION      GetMouseButton : BYTE;
  264. BEGIN
  265.       R.AX := 3;  Intr($33,R);
  266.     GetMouseButton := R.BX;
  267. END;     { GetMouseButton }
  268.  
  269.  
  270. FUNCTION    MouseTouched : BOOLEAN;
  271.         { TRUE, if Button is pressed or mouse was moved }
  272. VAR    dx, dy : INTEGER;
  273. BEGIN
  274.     MouseMove(dx, dy);
  275.  
  276.     MouseTouched := (dx <> 0)  OR  (dy <> 0)  OR
  277.                 (GetMouseButton <> NO_MOUSEBUTTON);
  278. END;    {  MouseTouched  }
  279.  
  280. END.    { UNIT MOUSE }
  281.